home *** CD-ROM | disk | FTP | other *** search
/ Mac Cube 4: Multimedia Applications / MacCube Volume 4: Multimedia Applications.iso / Graphics / NIH Image Folder / Macros / Measurement Macros < prev    next >
Text File  |  1993-09-01  |  14KB  |  612 lines
  1. macro 'Particle Analysis Test';
  2. var
  3.   x,y,rows,columns,maxradius,radius:integer;
  4. begin
  5.   SaveState;
  6.   rows:=5; columns:=5;
  7.   maxradius:=rows*columns;
  8.   SetForegroundColor(255);
  9.   SetBackgroundColor(0);
  10.   SetNewSize(columns*maxradius*2+20,rows*maxradius*2+20);
  11.   MakeNewWindow('Objects');
  12.   radius:=1;
  13.   for y:=0 to columns-1 do
  14.     for x:=0 to rows-1 do begin
  15.       MakeOvalRoi(x*maxradius*2+10,y*maxradius*2+10,radius*2,radius*2);
  16.       Fill;
  17.       radius:=radius+1;
  18.     end;
  19.   KillRoi;
  20.   SetParticleSize(1,9999);
  21.   LabelParticles(true);
  22.   OutlineParticles(true);
  23.   SetOptions('Area, Perimeter, Major, Minor');
  24.   AnalyzeParticles;
  25.   SetUser1Label('Perim.d');
  26.   SetUser2Label('Area');
  27.   for radius:=1 to maxradius do begin
  28.     rUser1[radius]:=2*3.14159*radius;
  29.     rUser2[radius]:=3.14159*sqr(radius);
  30.   end;
  31.   ShowResults;
  32.   RestoreState;
  33. end;
  34.  
  35.  
  36. macro 'Count Particles at Random Locations';
  37. var
  38.   n,i,width,height,PicID,nLocations:integer;
  39.   size:real;
  40. begin
  41.   RequiresVersion(1.44);
  42.   nLocations:=10;
  43.   size:=0.25;
  44.   n:=1;
  45.   GetPicSize(width,height);
  46.   PicID:=PicNumber;
  47.   SetUser1Label('Count');
  48.   SetOptions('User1');
  49.   for i:=1 to nLocations do begin
  50.     SelectPic(PicID);
  51.     MakeRoi((1-size)*width*random,(1-size)*height*random,size*width,size*height);
  52.     Duplicate('Temp');;
  53.     SetDensitySlice(255,255);
  54.     AnalyzeParticles;
  55.     Dispose;
  56.     rUser1[i]:=rCount;
  57.   end;
  58.   KillRoi;
  59.   SetCounter(nLocations);
  60.   ShowResults;
  61. end;
  62.  
  63.  
  64. macro 'Make Circle from Line';
  65. var
  66.   x1,x2,y1,y2,top,left,width,height:integer;
  67.   xcenter,ycenter,radius:integer;
  68. begin
  69.   GetLine(x1,y1,x2,y2,width);
  70.   if x1<0 then begin
  71.     PutMessage('This macro requires a line selection.');
  72.     exit;
  73.   end;
  74.   xcenter:=x1+(x2-x1)/2;
  75.   ycenter:=y1+(y2-y1)/2;
  76.   radius:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2;
  77.   MakeOvalROI(xcenter-radius,ycenter-radius,radius*2,radius*2);
  78. end;
  79.  
  80.  
  81. macro 'Display Calibration Table';
  82. {
  83. Stores 0-255(all possible gray values) in the User1 column
  84. and the 256 corresponding calibrated values in the User2 column.
  85. Max Measurements must be set to 256 or greater. Use the Export
  86. command to export the calibration table to a text file. The two
  87. columns will be identical if the image is not calibrated.
  88. }
  89. var
  90.   i:integer;
  91.   v:real;
  92. begin
  93.   RequiresVersion(1.44);
  94.   SetCounter(256);
  95.   SetUser1Label('value');
  96.   SetUser2Label('cvalue');
  97.   for i:=0 to 255 do begin
  98.     rUser1[i+1]:=i;
  99.     rUser2[i+1]:=cvalue(i);
  100.   end;
  101.   ShowResults;
  102. end;
  103.  
  104.  
  105. macro 'Measure and draw line [L]';
  106. var
  107.   x1,x2,y1,y2,width:integer;
  108. begin
  109.   GetLine(x1,y1,x2,y2,width);
  110.   if x1<0 then begin
  111.     PutMessage('This macro requires a straight line selection.');
  112.     exit;
  113.   end;
  114.   Measure;
  115.   Fill;
  116.   KillRoi;
  117. end;
  118.  
  119. macro 'Measure and Outline [M]';
  120. begin
  121.   Measure;
  122.   DrawBoundary;
  123.   DrawBoundary;
  124. end;
  125.  
  126.  
  127. macro 'Measure All';
  128. {Measures all currently open images using the current selection. There is}
  129. {an implied "Select All" if the active image doesn't have a selection.}
  130. var
  131.   i,left,top,width,height:integer;
  132. begin
  133.   ResetCounter;
  134.   for i:=1 to nPics do begin
  135.     SelectPic(i);
  136.     RestoreROI;
  137.     Measure;
  138.   end;
  139. end;
  140.  
  141.  
  142. macro 'Measure All from Disk';
  143. {
  144. Reads from disk and measures a set of images too large to simultaneously
  145. fit in memory. The image names names must be in the form '01', '02', etc.
  146. Before starting, open and outline the first image('01').
  147. }
  148. var
  149.   i,width,height:integer;
  150. begin
  151.   GetPicSize(width,height);
  152.   if width=0 then begin
  153.     PutMessage('Before running this macro, open and outline the first image("01") in the series.');
  154.     exit;
  155.   end;
  156.   ResetCounters;
  157.   Measure;
  158.   close;
  159.   for i:=2 to 1000 do begin
  160.     open(i:2);
  161.     RestoreROI;
  162.     Measure;
  163.     close;
  164.   end;
  165. end;
  166.  
  167.  
  168. macro 'Paste Results'
  169. {Use the Measure command, the ruler tool, or the pointing tool to}
  170. {make up to about 10 measurements, then use this macro to paste}
  171. {the results into the upper left corner of the window.}
  172. begin
  173.   SetFont('Monaco');
  174.   SetFontSize(9);
  175.   SetText('Plain; Align Left');
  176.   SetOption; {Copy headings}
  177.   CopyResults;
  178.   MakeRoi(-10,0,250,150);
  179.   Paste;
  180.   KillRoi;
  181.   ResetCounter;
  182. end;
  183.  
  184.  
  185. macro 'Measure Redirected and Label'
  186. begin
  187.   Redirect(true);
  188.   Measure;
  189.   Redirect(false);
  190.   MarkSelection;
  191.   RestoreRoi;
  192. end;
  193.  
  194.  
  195. macro 'Reset Measurement Options';
  196. {Resets the Options dialog box in the Analyze menu to the default settings.}
  197. begin
  198.   RequiresVersion(1.44);
  199.   SetOptions('Area; Mean');
  200.   Redirect(false);
  201.   LabelParticles(true);
  202.   OutlineParticles(false);
  203.   IgnoreParticlesTouchingEdge(false);
  204.   IncludeInteriorHoles(false);
  205.   WandAutoMeasure(false);
  206.   AdjustAreas(false);
  207.   SetParticleSize(1,999999);
  208.   SetPrecision(2);
  209. end;
  210.  
  211.  
  212. macro 'Set Threshold';
  213. var
  214.   lower,upper:integer;
  215. begin
  216.   lower:=GetNumber('Lower:',1);
  217.   upper:=GetNumber('Upper:',254);
  218.   SetDensitySlice(lower,upper);
  219. end;
  220.  
  221.  
  222. macro 'Measure Accumulated Perimeter[A]';
  223. {
  224. Measures perimeter and computes accumulated perimeter,
  225. storing it in the User1 column.
  226. }
  227. var
  228.   i:integer;
  229.   Total:real;
  230. begin
  231.   MeasurePerimeter(true);
  232.   SetOptions('Area; Mean; Perimeter; User1');
  233.   SetUser1Label('Total');
  234.   Measure;
  235.   Total:=0;
  236.   for i:=1 to rCount do Total:=Total+rLength[i];
  237.   rUser1[rCount]:=Total;
  238.   UpdateResults;
  239. end;
  240.  
  241.  
  242. macro 'Count Black and White Pixels [B]';
  243. {
  244. Counts the number of black and white pixels in the current
  245. selection and stores the counts in the User1 and User2 columns.
  246. }
  247. begin
  248.   RequiresVersion(1.44);
  249.   SetUser1Label('Black');
  250.   SetUser2Label('White');
  251.   Measure;
  252.   rUser1[rCount]:=histogram[255];
  253.   rUser2[rCount]:=histogram[0];
  254.   UpdateResults;
  255. end;
  256.  
  257.  
  258. macro 'Compute Percent Black and White';
  259. {
  260. Computes the percentage of back and white pixels in the
  261. current selection. This macro only works with binary images.
  262. }
  263. var
  264.   nPixels,mean,mode,min,max:real;
  265. begin
  266.   RequiresVersion(1.44);
  267.   SetUser1Label('Black');
  268.   SetUser2Label('White');
  269.   Measure;
  270.   GetResults(nPixels,mean,mode,min,max);
  271.   rUser1[rCount]:=histogram[255]/nPixels;
  272.   rUser2[rCount]:=histogram[0]/nPixels;
  273.   UpdateResults;
  274.   if (histogram[0]+histogram[255])<>nPixels
  275.     then PutMessage('This macro requires a binary image.');
  276. end;
  277.  
  278.  
  279. macro 'Compute Area Percentage [P]';
  280. {
  281. Computes the percentage of foreground
  282. pixels in the current selection.
  283. }
  284. var
  285.   mean,mode,min,max:real;
  286.   i,lower,upper,fPixels,nPixels,count:integer;
  287. begin
  288.   RequiresVersion(1.50);
  289.   SetUser1Label('%');
  290.   Measure;
  291.   GetResults(nPixels,mean,mode,min,max);
  292.   GetThresholds(lower,upper);
  293.   if (lower=0) and (upper=0) and 
  294.      ((histogram[0]+histogram[255])<>nPixels)
  295.      then begin
  296.        PutMessage('This macro requires a binary or thresholded image.');
  297.        exit;
  298.      end;
  299.   if nPixels=0 then begin
  300.   end;
  301.   if (lower=0) and (upper=0) then begin
  302.     if nPixels=0
  303.       then rUser1[rCount]:=0
  304.       else rUser1[rCount]:=(histogram[255]/nPixels)*100;
  305.     UpdateResults;
  306.     exit;
  307.   end;
  308.   fPixels:=0;
  309.   nPixels:=0;
  310.   for i:=0 to 255 do begin
  311.     count:=histogram[i];
  312.     nPixels:=nPixels+count;
  313.     if (i>=lower) and (i<=upper)
  314.       then fPixels:=fPixels+count;
  315.   end;
  316.   rUser1[rCount]:=(fPixels/nPixels)*100;
  317.   UpdateResults;
  318. end;
  319.  
  320.  
  321. macro 'Compute Average and Total Area [T]';
  322. {
  323. Computes average and accumulated area and stores 
  324. the them in the Major and Minor Axis columns.
  325. }
  326. var
  327.   i:integer;
  328.   sum:real;
  329. begin
  330.   RequiresVersion(1.44);
  331.   SetUser1Label('Avg');
  332.   SetUser2Label('Total');
  333.   SetOptions('Area; User1; User2');
  334.   Measure;
  335.   sum:=0;
  336.   for i:=1 to rCount do sum:=sum+rArea[i];
  337.   rUser1[rCount]:=sum/rCount;
  338.   rUser2[rCount]:=sum;
  339.   UpdateResults;
  340. end;
  341.  
  342.  
  343. macro 'Measure Circularity';
  344. begin
  345.   SetUser1Label('Shape');
  346.   Measure;
  347.   rUser1[rCount]:=4*3.14159265*(rArea[rCount]/sqr(rLength[rCount]));
  348.   UpdateResults;
  349. end;
  350.  
  351.  
  352. macro 'Measure Mean * Area';
  353. begin
  354.   SetUser1Label('Mean*Area');
  355.   Measure;
  356.   rUser1[rCount]:=rMean[rCount]*rArea[rCount];
  357.   UpdateResults;
  358. end;
  359.  
  360.  
  361. macro 'Draw Fitted Ellipse in White';
  362. var
  363.   left,top,width,height:real;
  364. begin
  365.   GetRoi(left,top,width,height);
  366.   if width=0 then begin
  367.     PutMessage('This macro requires a selection.');
  368.     exit;
  369.   end;
  370.   SetOptions('Area; Mean; X-Y Center');
  371.   Measure;
  372.   SetOption; MarkSelection;
  373.   KillRoi;
  374.   SelectAll;
  375.   KillRoi;
  376.  end;
  377.  
  378.  
  379. macro 'Draw XY Center';
  380. var
  381.   left,top,width,height,x,y:real;
  382. begin
  383.   RequiresVersion(1.44);
  384.   GetRoi(left,top,width,height);
  385.   if width=0 then begin
  386.     PutMessage('This macro requires a selection.');
  387.     exit;
  388.   end;
  389.   SaveState; {Invert Y status saved starting with V1.44b21}
  390.   InvertY(false);
  391.   SetForegroundColor(255); {black}
  392.   SetOptions('Area; Mean; X-Y Center'); {XY Center}
  393.   Measure;
  394.   KillRoi;
  395.   x:=rX[rCount];
  396.   y:=rY[rCount];
  397.   MoveTo(x-5,y);
  398.   LineTo(x+5,y);
  399.   MoveTo(x,y-5);
  400.   LineTo(x,y+5);
  401.   RestoreState;
  402. end;
  403.  
  404.  
  405. macro 'Plot Radial Density Profiles [R]';
  406. var
  407.   x1,y1,x2,y2,pi,angle,delta:real;
  408.   LineWidth,i,nLines,radius,PlotWidth,PlotHeight:integer;
  409.   MinPlotWidth,hMargin,vMargin,PlotLeft,PlotTop:integer;
  410.   LeftMargin,RightMargin,TopMargin,BottomMargin:integer;
  411.   ImageWindow,PlotWindow:integer;
  412.   nPixels,mean,mode,min,max:real;
  413. begin
  414.   RequiresVersion(1.45);
  415.   SaveState;
  416.   GetLine(x1,y1,x2,y2,LineWidth)
  417.   if x1<0 then begin
  418.     PutMessage('Please select a point by clicking with the line tool.');
  419.     exit;
  420.   end;
  421.   radius:=20;
  422.   nLines:=8;
  423.   MinPlotWidth:=140;
  424.   pi:=3.14159;
  425.   delta:=2.0*pi/nLines;
  426.   angle:=0.0;
  427.   PlotWidth:=radius;
  428.   if PlotWidth<MinPlotWidth then PlotWidth:=MinPlotWidth;
  429.   PlotHeight:=0.4*PlotWidth;
  430.   SetPlotSize(PlotWidth,PlotHeight);
  431.   MakeOvalRoi(x1-radius,y1-radius,radius*2,radius*2);
  432.   Measure;
  433.   GetResults(nPixels,mean,mode,min,max);
  434.   min:=min-10;
  435.   if min<0 then min:=0;
  436.   max:=max+10;
  437.   if max>255 then max:=255;
  438.   SetPlotScale(cValue(min),cValue(max));
  439.   SetPlotLabels(false);
  440.   hMargin:=5;
  441.   vMargin:=5;
  442.   if Calibrated
  443.     then LeftMargin:=35
  444.     else LeftMargin:=25;
  445.   TopMargin:=10;
  446.   RightMargin:=10;
  447.   BottomMargin:=20;
  448.   PlotLeft:=hMargin-LeftMargin;
  449.   PlotTop:=vMargin-TopMargin;
  450.   SetNewSize(PlotWidth+2*hMargin,PlotHeight*nLines);
  451.   SetForegroundColor(255);
  452.   SetBackgroundColor(0);
  453.   ImageWindow:=PicNumber;
  454.   MakeNewWindow('Plots');
  455.   PlotWindow:=PicNumber;
  456.   SelectPic(ImageWindow);
  457.   for i:=1 TO nLines do begin
  458.     x2:=x1+round(radius*cos(angle));
  459.     y2:=y1+round(radius*sin(angle));
  460.     MakeLineRoi(x1,y1,x2,y2);
  461.     PlotProfile;
  462.     Copy;
  463.     SelectPic(PlotWindow);
  464.     MakeRoi(PlotLeft,PlotTop,PlotWidth+LeftMargin+RightMargin,
  465.           PlotHeight+TopMargin+BottomMargin);
  466.     Paste;
  467.     DoOr;
  468.     PlotTop:=PlotTop+PlotHeight-1;
  469.     SelectPic(ImageWindow);
  470.     angle:=angle+delta;
  471.   end;
  472.   RestoreState;
  473. end;
  474.  
  475.  
  476. macro 'Circular Profile Plot [C]';
  477. var
  478.   radius,pi,angle,dx,dy,delta:real;
  479.   x1,y1,x2,y2:real;
  480.   npoints,i,value,LineWidth,x,y,px:integer;
  481. begin
  482.   GetLine(x1,y1,x2,y2,LineWidth)
  483.   if x1<0 then begin
  484.     PutMessage('Please select a point by clicking with the line tool.');
  485.     exit;
  486.   end;
  487.   x:=x1+(x2-x1)/2;
  488.   y:=y1+(y2-y1)/2;
  489.   radius:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2;
  490.   if radius<3 then begin
  491.     PutMessage('The line selection must be longer than 5 pixels.');
  492.     exit;
  493.   end;
  494.   npoints:=radius*2;
  495.   pi:=3.14159;
  496.   delta:=2.0*pi/npoints;
  497.   angle:=0.0;
  498.   px:=0;
  499.   for i:=1 TO npoints do begin
  500.     dx:=round(radius*cos(angle));
  501.     dy:=round(radius*sin(angle));
  502.     value:=GetPixel(x+dx,y+dy);
  503.     PutPixel(x+dx,y+dy,255);
  504.     PutPixel(px,0,value);
  505.     px:=px+1;
  506.     angle:=angle+delta;
  507.   end;
  508.   MakeLineRoi(0,0,npoints,0);
  509.   PlotProfile;
  510.   KillRoi;
  511. end;
  512.  
  513.  
  514. macro 'Compute Spatial Scale';
  515. var
  516.   scale:real;
  517. begin
  518.   MakeLineRoi(0,0,100,0);
  519.   Measure;
  520.   KillRoi;
  521.   Scale:=100/rLength[rCount]);
  522.   if scale=1
  523.     then PutMessage('Image is not spatially calibrated')
  524.     else PutMessage('Scale=',scale:1:4,' pixels/unit');
  525. end;
  526.  
  527.  
  528. macro 'Store Break in Results [S]';
  529. {Stores a row of zeros in the results table.}
  530. begin
  531.   Measure;
  532.   rArea[rCount]:=0;
  533.   rMean[rCount]:=0;
  534.   rStdDev[rCount]:=0;
  535.   rX[rCount]:=0;
  536.   rY[rCount]:=0;
  537.   rLength[rCount]:=0;
  538.   rMajor[rCount]:=0;
  539.   rMinor[rCount]:=0;
  540.   rAngle[rCount]:=0;
  541.   UpdateResults;
  542. end;
  543.  
  544.  
  545. macro 'Measure both Raw and Calibrated';
  546. {
  547. This macro is a variation of the Measure command that displays the number
  548. of pixels in User1 and uncalibrated(raw) mean density in User2. It takes
  549. advantage of the fact that GetResults always returns uncalibrated values.
  550. }
  551. var
  552.   nPixels,mean,mode,min,max:real;
  553. begin
  554.   SetUser1Label('Pixels');
  555.   SetUser2Labe2('Raw Mean');
  556.   Measure;
  557.   GetResults(nPixels,mean,mode,min,max);
  558.   rUser1[rCount]:=nPixels;
  559.   rUser2[rCount]:=mean;
  560.   UpdateResults;
  561. end;
  562.  
  563.  
  564. macro 'Plot X-Y Coordinates';
  565. {Plots the X-Y Coordinates of the current ROI.}
  566. var
  567.   i,w,h,width,height:integer;
  568.   xbase,ybase,RoiWidth,RoiHeight:integer
  569.   x,y,scale,xmax,ymax:real 
  570. begin
  571.   RequiresVersion(1.48);
  572.   if nCoordinates=0 then begin
  573.     PutMessage('No XY-Coordinates currently available.');
  574.     exit;
  575.   end;
  576.   GetRoi(xbase,ybase,RoiWidth,RoiHeight);
  577.   SaveState;
  578.   InvertY(false);
  579.   xmax:=0;
  580.   ymax:=0;
  581.   for i:=1 to nCoordinates do begin
  582.     x:=xCoordinates[i];
  583.     y:=yCoordinates[i];
  584.     if x>xmax then xmax:=x;
  585.     if y>ymax then ymax:=y;
  586.   end;
  587.   scale:=sqrt((300*300)/(xmax*ymax));
  588.   if (xmax*scale)>500 then scale:=500/xmax;
  589.   if (ymax*scale)>500 then scale:=500/ymax;
  590.   SetForegroundColor(255);
  591.   SetBackgroundColor(0);
  592.   SetNewSize(xmax*scale+20,ymax*scale+20);
  593.   MakeNewWindow('Outline');
  594.   MoveTo(xCoordinates[1]*scale+10,yCoordinates[1]*scale+10);
  595.   for i:=2 to nCoordinates do
  596.     LineTo(xCoordinates[i]*scale+10,yCoordinates[i]*scale+10);
  597.   SetFont('Helvetica');
  598.   SetFontSize(12);
  599.   SetText('No background, Center');
  600.   GetPicSize(width,height);
  601.   MoveTo(width/2,height/3);
  602.   Writeln(nCoordinates:1,' coordinate pairs');
  603.   Writeln('Origin=',xbase:1,',',ybase:1);
  604.   RestoreState;
  605. end;
  606.  
  607.  
  608.  
  609.  
  610.  
  611.  
  612.